home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / macFont.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  6.2 KB  |  183 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test out the procedures in tkMacFont.c. 
  2. # It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Some of these tests are visually oriented and cannot be checked
  5. # programmatically (such as "does an underlined font appear to be
  6. # underlined?"); these tests attempt to exercise the code in question,
  7. # but there are no results that can be checked.  
  8. #
  9. # Copyright (c) 1996 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14. # SCCS: @(#) macFont.test 1.5 97/05/05 14:21:05
  15.  
  16. if {$tcl_platform(platform)!="macintosh"} {
  17.     return
  18. }
  19.  
  20. if {[string compare test [info procs test]] != 0} {
  21.     source defs
  22. }
  23.  
  24. catch {destroy .b}
  25. toplevel .b
  26. update idletasks
  27.  
  28. set courier {Courier 10}
  29. set cx [font measure $courier 0]
  30.  
  31. label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Monaco 9"
  32. pack .b.l
  33. canvas .b.c -closeenough 0
  34.  
  35. set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
  36. pack .b.c
  37. update
  38.  
  39. set ax [winfo reqwidth .b.l]
  40. set ay [winfo reqheight .b.l]
  41. proc getsize {} {
  42.     update
  43.     return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
  44. }
  45.  
  46. test macfont-1.1 {TkpGetNativeFont procedure: not native} {
  47.     list [catch {font measure {} xyz} msg] $msg
  48. } {1 {font "" doesn't exist}}
  49. test macfont-1.2 {TkpGetNativeFont procedure: native} {
  50.     font measure system "0"
  51.     font measure application "0"
  52.     set x {}
  53. } {}
  54.  
  55. test macfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
  56.     font actual {-underline 1} -family
  57. } [font actual system -family]
  58. test macfont-2.2 {TkpGetFontFromAttributes procedure: long family name} {
  59.     set x "12345678901234567890123456789012345678901234567890"
  60.     set x "$x$x$x$x$x$x"
  61.     font actual "-family $x" -family
  62. } [font actual system -family]
  63. test macfont-2.3 {TkpGetFontFromAttributes procedure: family} {
  64.     font actual {-family Courier} -family
  65. } {Courier}
  66. test macfont-2.4 {TkpGetFontFromAttributes procedure: Times fonts} {
  67.     set x {}
  68.     lappend x [font actual {-family "Times"} -family]
  69.     lappend x [font actual {-family "Times New Roman"} -family]
  70. } {Times Times}
  71. test macfont-2.5 {TkpGetFontFromAttributes procedure: Courier fonts} {
  72.     set x {}
  73.     lappend x [font actual {-family "Courier"} -family]
  74.     lappend x [font actual {-family "Courier New"} -family]
  75. } {Courier Courier}
  76. test macfont-2.6 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
  77.     set x {}
  78.     lappend x [font actual {-family "Geneva"} -family]
  79.     lappend x [font actual {-family "Helvetica"} -family]
  80.     lappend x [font actual {-family "Arial"} -family]
  81. } {Geneva Helvetica Helvetica}
  82. test macfont-2.7 {TkpGetFontFromAttributes procedure: styles} {
  83.     font actual {-weight normal} -weight
  84. } {normal}
  85. test macfont-2.8 {TkpGetFontFromAttributes procedure: styles} {
  86.     font actual {-weight bold} -weight
  87. } {bold}
  88. test macfont-2.9 {TkpGetFontFromAttributes procedure: styles} {
  89.     font actual {-slant roman} -slant
  90. } {roman}
  91. test macfont-2.10 {TkpGetFontFromAttributes procedure: styles} {
  92.     font actual {-slant italic} -slant
  93. } {italic}
  94. test macfont-2.11 {TkpGetFontFromAttributes procedure: styles} {
  95.     font actual {-underline false} -underline
  96. } {0}
  97. test macfont-2.12 {TkpGetFontFromAttributes procedure: styles} {
  98.     font actual {-underline true} -underline
  99. } {1}
  100. test macfont-2.13 {TkpGetFontFromAttributes procedure: styles} {
  101.     font actual {-overstrike false} -overstrike
  102. } {0}
  103. test macfont-2.14 {TkpGetFontFromAttributes procedure: styles} {
  104.     font actual {-overstrike true} -overstrike
  105. } {0}
  106.  
  107. test macfont-3.1 {TkpDeleteFont procedure} {
  108.     font actual {-family xyz}
  109.     set x {}
  110. } {}
  111.  
  112. test macfont-4.1 {TkpGetFontFamilies procedure} {
  113.     font families
  114.     set x {}
  115. } {}
  116.  
  117. test macfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
  118.     .b.l config -wrap 0 -text "000000"
  119.     getsize
  120. } "[expr $ax*6] $ay"
  121. test macfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
  122.     .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  123.     getsize
  124. } "[expr $ax*256] $ay"
  125. test macfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
  126.     .b.l config -wrap [expr $ax*10] -text "00000000"
  127.     getsize
  128. } "[expr $ax*8] $ay"
  129. test macfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
  130.     .b.l config -wrap [expr $ax*6] -text "00000000"
  131.     getsize
  132. } "[expr $ax*6] [expr $ay*2]"
  133. test macfont-5.5 {Tk_MeasureChars procedure: already saw space in line} {
  134.     .b.l config -wrap [expr $ax*12] -text "000000    0000000"
  135.     getsize
  136. } "[expr $ax*7] [expr $ay*2]"
  137. test macfont-5.6 {Tk_MeasureChars procedure: internal spaces significant} {
  138.     .b.l config -wrap [expr $ax*12] -text "000  00   00000"
  139.     getsize
  140. } "[expr $ax*7] [expr $ay*2]"
  141. test macfont-5.7 {Tk_MeasureChars procedure: include last partial char} {
  142.     .b.c dchars $t 0 end
  143.     .b.c insert $t 0 "0000"
  144.     .b.c index $t @[expr int($ax*2.5)],1
  145. } {2}
  146. test macfont-5.8 {Tk_MeasureChars procedure: at least one char on line} { 
  147.     .b.l config -text "000000" -wrap 1
  148.     getsize
  149. } "$ax [expr $ay*6]"
  150. test macfont-5.9 {Tk_MeasureChars procedure: whole words} {
  151.     .b.l config -wrap [expr $ax*8] -text "000000 0000"
  152.     getsize
  153. } "[expr $ax*6] [expr $ay*2]"
  154. test macfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
  155.     .b.l config -wrap [expr $ax*12] -text "0000000000000000"
  156.     getsize
  157. } "[expr $ax*12] [expr $ay*2]"
  158.  
  159. test macfont-6.1 {Tk_DrawChars procedure} {
  160.     .b.l config -text "a"
  161.     update
  162. } {}
  163.  
  164. test macfont-7.1 {AllocMacFont procedure: use old font} {
  165.     font create xyz
  166.     button .c -font xyz
  167.     font configure xyz -family times
  168.     update
  169.     destroy .c
  170.     font delete xyz
  171. } {}
  172. test macfont-7.2 {AllocMacFont procedure: extract info from style} {
  173.     font actual {Monaco 9 bold italic underline overstrike}
  174. } {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
  175. test macfont-7.3 {AllocMacFont procedure: extract text metrics} {
  176.     font metric {Geneva 10} -fixed
  177. } {0}
  178. test macfont-7.4 {AllocMacFont procedure: extract text metrics} {
  179.     font metric "Monaco 9" -fixed
  180. } {1}
  181.  
  182. destroy .b
  183.